perm filename MAP.1[MAC,LSP] blob sn#564917 filedate 1981-02-17 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Returns the list which is the memory map.
C00005 ENDMK
CāŠ—;
;;; Returns the list which is the memory map.

(defun mem-map ()
 (let ((st (getddtsym 'st)))
      (do ((i (+ st #o777) (1- i))
	   (l))
	  ((< i st) l)
	  (push (mem-type (examine i))
		l))))

(defun bit macro (x)
 ((lambda (x y)
   ((lambda (first)
	  (cond ((< y 1) first)
		(t (lsh first y))))
    (cond ((< x 1) 1)
	  (t (lsh 1 (* 9 x))))))
  (- (cadr x) 1) 
  (- (caddr x) 1)))

(defun mem-type (w)
 (setq w (lsh w -18.))
 (cond ((not (= 0 (boole 1 (bit 2 8) w)))
	(cond ((not (= 0 (boole 1 (bit 2 9) w))) 'list)
	      (t 'atom)))
       ((not (= 0 (boole 1 (bit 2 7) w))) 'fixnum)
       ((not (= 0 (boole 1 (bit 2 6) w))) 'flonum)
       ((not (= 0 (boole 1 (bit 2 5) w))) 'bignum-header)
       ((not (= 0 (boole 1 (bit 2 4) w))) 'symbol-header)
       ((not (= 0 (boole 1 (bit 2 3) w)))
	'Array-header) 
       ((not (= 0 (boole 1 (bit 2 2) w)))
	'Value-cell)
       ((not (= 0 (boole 1 (bit 2 1) w))) 'number-pdl)
       ((not (= 0 (boole 1 (bit 1 8) w))) 'allocated-random)
       ((not (= 0 (boole 1 (bit 1 7) w))) 'unallocated-random)
       ((not (= 0 (boole 1 (bit 1 6) w))) 'pure)
       ((not (= 0 (boole 1 (bit 1 5) w))) 'hunk)
       (t 'unknown)))